;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "Iskill-sets-criterion.lisp")
(require "Itranspose-fast.lisp")
(require "Imerge-sort.lisp")
(require "Ilist.lisp")
(require "Itrim.lisp")

(module Mskill-sets-criterion
  
(import Itranspose-fast)
(import Ilist)
(import Imerge-sort)
(import Itrim)

(include-book "io-utilities" :dir :teachpacks)
(include-book "list-utilities" :dir :teachpacks)

#|--------------------------------------------
  constants
----------------------------------------------|#

(defconst *NO-SUB-WEIGHT-INPUT* "NO SUB-WEIGHT INPUT")

(defconst *INVALID-INPUT-SPECIFICATION-LINE*
  "INVALID INPUT IN SPECIFICATION LINE!")
(defconst *INVALID-GENDER-INPUT*
  "INVALID GENDER INPUT!")

(defconst *SKILL-SET* "SKILL SET")

#| -------------------------------------------|#
  
(defun read-individual-input-skill-sets
  (individual-skill-sets-as-strs)
   (if (consp individual-skill-sets-as-strs)
       (let* ((individual-first-skill-set-as-str
               (car individual-skill-sets-as-strs))
              (individual-first-skill-set
               (trim-list-of-strs 
                (map-chrs->str
                 (remove nil 
                         (packets #\, 
                                  (str->chrs individual-first-skill-set-as-str)))))))
         (cons individual-first-skill-set
               (read-individual-input-skill-sets (cdr individual-skill-sets-as-strs))))
       nil))

(defun read-all-team-member-input-skill-sets
  (all-team-member-input-skill-sets-as-strs)
  (if (consp all-team-member-input-skill-sets-as-strs)
      (let* ((first-team-member-skill-sets-as-str
              (car all-team-member-input-skill-sets-as-strs))
             (first-team-member-skill-sets-as-strs
              (trim-list-of-strs 
               (map-chrs->str
                (remove nil 
                        (packets #\;
                                 (str->chrs first-team-member-skill-sets-as-str))))))
             (first-team-member-input-skill-sets
              (read-individual-input-skill-sets first-team-member-skill-sets-as-strs)))
        (cons first-team-member-input-skill-sets
              (read-all-team-member-input-skill-sets
               (cdr all-team-member-input-skill-sets-as-strs))))
      nil))

(defun which-considered-skill-set-aux
  (skill considered-skill-sets n)
  (if (consp considered-skill-sets)
      (if (member-equal skill
                        (car considered-skill-sets))
          n
          (which-considered-skill-set-aux skill
                                          (cdr considered-skill-sets)
                                          (1+ n)))
      -1))

(defun which-considered-skill-set
  (member-skills considered-skill-sets)
  (if (consp member-skills)
      (let ((of-skill-set-base-on-first-skill
             (which-considered-skill-set-aux (car member-skills)
                                             considered-skill-sets
                                             0)))
        (if (= of-skill-set-base-on-first-skill
               -1)
            (which-considered-skill-set (cdr member-skills)
                                        considered-skill-sets)
            of-skill-set-base-on-first-skill))
      -1))

(defun get-all-team-member-skills-by-skill-set-position-aux
  (individual-skill-sets converted-skill-sets)
  (if (consp individual-skill-sets)
      (let* ((individual-first-skill-set
              (car individual-skill-sets))
             (first-skill-set-is-of
              (which-considered-skill-set (car individual-skill-sets)
                                          converted-skill-sets))
             (individual-skill-sets-but-first
              (cdr individual-skill-sets))
             (rest-skill-sets-are-of
              (get-all-team-member-skills-by-skill-set-position-aux
               (cdr individual-skill-sets)
               converted-skill-sets))) 
          (if (= first-skill-set-is-of
                 -1)
              rest-skill-sets-are-of
              (cons (list individual-first-skill-set
                          first-skill-set-is-of)
                    rest-skill-sets-are-of)))
      nil))

(defun get-all-team-member-skills-by-skill-set-position
  (team-skill-sets considered-skill-sets)
  (if (consp team-skill-sets)
      (append (get-all-team-member-skills-by-skill-set-position-aux
               (car team-skill-sets)
               considered-skill-sets)
              (get-all-team-member-skills-by-skill-set-position (cdr team-skill-sets)
                                                                considered-skill-sets))
      nil))

(defun convert-individual-skill-set-aux
  (individual-skills considered-skill-set converted-skills)
  (if (consp individual-skills)
      (let* ((first-skill
              (car individual-skills))
             (first-skill-position
             (position-equal first-skill
                             considered-skill-set))
             (updated-converted-skills
              (if first-skill-position
                  (update-nth first-skill-position 
                              1 
                              converted-skills)
                  converted-skills)))
        (convert-individual-skill-set-aux (cdr individual-skills)
                                          considered-skill-set
                                          updated-converted-skills))
      converted-skills))

(defun convert-all-team-member-skill-set
  (all-team-member-skills-of-skill-set considered-skill-set)
  (if (consp all-team-member-skills-of-skill-set)
      (let* ((first-team-member-skill
              (car all-team-member-skills-of-skill-set))
             (considered-skill-set-len
              (len considered-skill-set))
             (converted-skill-set
              (replicate considered-skill-set-len
                         0)))
        (cons (convert-individual-skill-set-aux first-team-member-skill
                                                considered-skill-set
                                                converted-skill-set)
              (convert-all-team-member-skill-set
               (cdr all-team-member-skills-of-skill-set)
               considered-skill-set)))
      nil))

(defun calculate-team-skill-set-score-aux
  (converted-all-team-member-skills-of-considered-skill-set-transpose)
  (if (consp converted-all-team-member-skills-of-considered-skill-set-transpose)
      (let* ((all-team-member-skills-of-first-skill
              (car converted-all-team-member-skills-of-considered-skill-set-transpose))
             (sum-of-all-team-member-first-skill-of-skill-set
              (sumlist all-team-member-skills-of-first-skill))
             (d-square
              (if (<= sum-of-all-team-member-first-skill-of-skill-set
                      1)
                  0
                  (* sum-of-all-team-member-first-skill-of-skill-set
                     sum-of-all-team-member-first-skill-of-skill-set))))
        (cons d-square
              (calculate-team-skill-set-score-aux 
               (cdr converted-all-team-member-skills-of-considered-skill-set-transpose))))
      nil))

(defun calculate-team-skill-set-score
  (converted-all-team-member-skills-of-considered-skill-set
   num-of-members
   num-of-considered-skills-in-skill-set
   skill-set-actual-sub-weight)
  (if (not (or (endp converted-all-team-member-skills-of-considered-skill-set)
               (zerop skill-set-actual-sub-weight)))
      (* (max (- 1 
                 (/ (sumlist
                     (calculate-team-skill-set-score-aux
                      (transpose-fast
                       converted-all-team-member-skills-of-considered-skill-set)))
                    (* num-of-members
                       num-of-considered-skills-in-skill-set)))
              0)
         skill-set-actual-sub-weight)
      0))

(defun calculate-all-team-member-skill-sets-scores
  (all-team-member-skills-by-skill-set-with-position-sorted
   num-of-members
   considered-skill-sets-specifications)
  (if (and (consp considered-skill-sets-specifications)
           (consp all-team-member-skills-by-skill-set-with-position-sorted))
      (let* ((all-team-member-skills-by-skill-set
              (strip-cars all-team-member-skills-by-skill-set-with-position-sorted))
             (all-team-member-skills-by-skill-set-position
              (strip-cars
               (strip-cdrs all-team-member-skills-by-skill-set-with-position-sorted)))
             (first-considered-skill-set-by-position
              (car all-team-member-skills-by-skill-set-position))
             (first-considered-skill-set-data
              (nth first-considered-skill-set-by-position considered-skill-sets-specifications))
             (first-considered-skill-set
              (caddr first-considered-skill-set-data))
             (first-considered-skill-set-actual-sub-weight
              (cadr first-considered-skill-set-data))
             (num-of-considered-skills-in-first-considered-skill-set
              (len first-considered-skill-set))
             (all-team-member-skills-by-skill-set-position-w/o-first
              (drop-set (list first-considered-skill-set-by-position)
                        all-team-member-skills-by-skill-set-position))
             (second-considered-skill-set-by-position 
              (car all-team-member-skills-by-skill-set-position-w/o-first))
             (all-team-member-skills-of-first-considered-skill-set-by-position 
              (take-to second-considered-skill-set-by-position 
                       all-team-member-skills-by-skill-set-position))
             (length
              (len all-team-member-skills-of-first-considered-skill-set-by-position))
             (all-team-member-skills-of-first-considered-skill-set
              (car 
               (break-at-nth length
                             all-team-member-skills-by-skill-set)))
             (all-team-member-skills-by-skill-set-but-first-considered-skill-set-with-position
              (cadr 
               (break-at-nth length
                             all-team-member-skills-by-skill-set-with-position-sorted)))
             (converted-all-team-member-skills-of-first-considered-skill-set
              (convert-all-team-member-skill-set all-team-member-skills-of-first-considered-skill-set
                                                 first-considered-skill-set))
             (team-first-considered-skill-set-score
              (calculate-team-skill-set-score converted-all-team-member-skills-of-first-considered-skill-set
                                              num-of-members
                                              num-of-considered-skills-in-first-considered-skill-set
                                              first-considered-skill-set-actual-sub-weight)))
        (cons team-first-considered-skill-set-score
              (calculate-all-team-member-skill-sets-scores 
               all-team-member-skills-by-skill-set-but-first-considered-skill-set-with-position
               num-of-members
               considered-skill-sets-specifications)))
      nil))

(defun calculate-team-skill-sets-score
  (list-of-all-team-member-data-by-criterion
   num-of-members
   considered-skill-sets-specifications
   skill-set-actual-total-weight)
  (if (not (or (endp list-of-all-team-member-data-by-criterion)
               (zerop skill-set-actual-total-weight)))
      (let* ((all-team-member-input-skill-sets-as-strs
              (cadddr list-of-all-team-member-data-by-criterion))
             (all-team-member-input-skill-sets
              (read-all-team-member-input-skill-sets all-team-member-input-skill-sets-as-strs))
             (considered-skill-sets
              (strip-cars
               (strip-cdrs
                (strip-cdrs considered-skill-sets-specifications))))
             (all-team-member-skills-by-skill-set-position
              (get-all-team-member-skills-by-skill-set-position all-team-member-input-skill-sets
                                                                considered-skill-sets))
             (all-team-member-skill-sets-scores
              (calculate-all-team-member-skill-sets-scores
               (merge-sort all-team-member-skills-by-skill-set-position)
               num-of-members
               considered-skill-sets-specifications)))
        (* (sumlist all-team-member-skill-sets-scores)
           skill-set-actual-total-weight))
      0))

  (export Iskill-sets-criterion))

